home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / smaltalk / st80_pr4.lha / st80_pre4 / MoDE / Examples-Shan.st < prev    next >
Text File  |  1993-07-24  |  27KB  |  821 lines
  1. ExpandedMode subclass: #SimpleSubMode
  2.     instanceVariableNames: ''
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'Examples-Shan'!
  6.  
  7.  
  8. !SimpleSubMode methodsFor: 'initialize-release'!
  9.  
  10. initialize
  11.     super initialize.
  12.     self borderColor: Form gray.
  13.     self borderWidth: 2.
  14.     highlightDispObj _ #colorBorderHighlight.! !
  15.  
  16. !SimpleSubMode methodsFor: 'controller access'!
  17.  
  18. defaultControllerClass
  19.     ^SimpleSubController1! !
  20.  
  21. Mode subclass: #LineMode
  22.     instanceVariableNames: 'ascending '
  23.     classVariableNames: ''
  24.     poolDictionaries: ''
  25.     category: 'Examples-Shan'!
  26.  
  27.  
  28. !LineMode methodsFor: 'event-handling'!
  29.  
  30. interestedIn: event 
  31.     "This is the place to define the sensitive region.  My sensitive region   
  32.      is an approximation of a line with width 8.  Shan April 11, 1989"
  33.     "The displayBox in LineMode should always identical in size with the   
  34.     bounding box of the display object."
  35.  
  36.     | p1 p2 dispBox pointOnLine dist |
  37.     (super interestedIn: event)
  38.         ifFalse: [^false].
  39.     dispBox _ self unclippedDisplayBox.
  40.     ascending
  41.         ifTrue: 
  42.             [p1 _ dispBox bottomLeft.
  43.             p2 _ dispBox topRight]
  44.         ifFalse: 
  45.             [p1 _ dispBox origin.
  46.             p2 _ dispBox corner].
  47.     pointOnLine _ event origin pointNearestLine: p1 to: p2.
  48.     dist _ (event origin - pointOnLine) abs.
  49.     ^dist <= (2 @ 2)! !
  50.  
  51. !LineMode methodsFor: 'access'!
  52.  
  53. ascending
  54.     ^ascending! !
  55.  
  56. !LineMode methodsFor: 'private'!
  57.  
  58. from: fP to: tP width: w color: mask 
  59.     "Ascending denotes the slop of the line in the screen coordinates.  
  60.     Since the coordinates are different than what we commonly used in 
  61.     Math.  I used a different term.  It is useful to compute the sensitive 
  62.     region of a line.  Shan April 11, 1989"
  63.  
  64.     | origin corner rect |
  65.     (tP y - fP y / (tP x - fP x)) negative
  66.         ifTrue: [ascending _ true]
  67.         ifFalse: [ascending _ false].
  68.     origin _ fP min: tP.
  69.     corner _ fP max: tP.
  70.     rect _ origin corner: corner + w asPoint.
  71.     self window: (0 @ 0 extent: rect extent)
  72.         viewport: rect.
  73.     dispObj clear.
  74.     dispObj relAdd: (MMSLine
  75.             from: fP - origin
  76.             to: tP - origin
  77.             width: w color: mask).
  78.     self scaledBackground.! !
  79. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  80.  
  81. LineMode class
  82.     instanceVariableNames: ''!
  83.  
  84.  
  85. !LineMode class methodsFor: 'instance creation'!
  86.  
  87. from: fP to: tP width: w color: mask 
  88.     ^self new
  89.         from: fP
  90.         to: tP
  91.         width: w
  92.         color: mask! !
  93.  
  94. OpaqueController1 subclass: #MoveImageController1
  95.     instanceVariableNames: ''
  96.     classVariableNames: 'MoveImageController1ERD '
  97.     poolDictionaries: ''
  98.     category: 'Examples-Shan'!
  99.  
  100. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  101.  
  102. MoveImageController1 class
  103.     instanceVariableNames: ''!
  104.  
  105.  
  106. !MoveImageController1 class methodsFor: 'initialize'!
  107.  
  108. ERDinit
  109.     MoveImageController1ERD _ super eventResponsesDict deepCopy.
  110.     MoveImageController1ERD at: #leftButtonDown put: #moveImageConstrained.
  111.     MoveImageController1ERD at: #enterMode put: #highlight.
  112.     MoveImageController1ERD at: #leaveMode put: #deHighlight! !
  113.  
  114. !MoveImageController1 class methodsFor: 'access'!
  115.  
  116. eventResponsesDict
  117.     ^MoveImageController1ERD! !
  118.  
  119. Object subclass: #TestExamples
  120.     instanceVariableNames: ''
  121.     classVariableNames: ''
  122.     poolDictionaries: ''
  123.     category: 'Examples-Shan'!
  124.  
  125. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  126.  
  127. TestExamples class
  128.     instanceVariableNames: ''!
  129.  
  130.  
  131. !TestExamples class methodsFor: 'enter/leaveMode test'!
  132.  
  133. enterLeaveTest
  134.     "(RootMode new addSubMode: self enterLeaveTest) startUp" 
  135.     "There are 4 test cases embadded here.  See the design document for 
  136.     details. "
  137.     "Shan Mrach 15, 1989"
  138.  
  139.     | rMode m1 m1Sub m2 m3 |
  140.     rMode _ ExpandedMode new.
  141.     m1 _ Simple extent: 200@200.
  142.     m1 insideColor: Form white.
  143.     m2 _ Simple newMode.
  144.     m2 insideColor: Form veryLightGray.
  145.     m3 _ Simple newMode. 
  146.     m2 controller: ShowhandController1 new.
  147.     m1Sub _ Simple newMode.
  148.     m1Sub insideColor: Form veryLightGray.
  149.     m1
  150.         addSubMode: m1Sub.
  151.     rMode
  152.         addSubMode: m3
  153.         at: 100@100.
  154.     rMode
  155.         addSubMode: m1
  156.         at: 150@20.
  157.     rMode
  158.         addSubMode: m2
  159.         at: 60@170.
  160.     ^rMode resizeStyle: ResizeStyle stickFourCorners! !
  161.  
  162. !TestExamples class methodsFor: 'hungUp rescue'!
  163.  
  164. reinitializeEventQ
  165.     "When the interaction seems to lag for one event, run this method. 
  166.     Shan March 7, 1990"
  167.  
  168.     "self reinitializeEventQ"
  169.     EventQueue initialize!
  170.  
  171. rescueMessages
  172.     "When an event-driven application goes wrong.  The keyboard will be 
  173.     hung up because the event genration mechanism prevent the 
  174.     provision of Smalltalk keyboardEvent.  The way to fix it is to select 
  175.     the 'EventQ disable' message.  In the future, a fix in the InputState1 
  176.     may be necessary."
  177.     "Shan March 15, 1989"
  178.  
  179.     "EventQ disable.
  180.     MMSStdSysController allInstances do: [:each| each closeAndUnschedule].
  181.     EventQ flush"! !
  182.  
  183. !TestExamples class methodsFor: 'future use'!
  184.  
  185. subModeTest
  186.     "TestExamples subModeTest"
  187.     "The method 'addSubMode:in:' is not supported in the current version.  
  188.     Shan March 26, 1989"
  189.  
  190.     | rMode sMode sSMode |
  191.     rMode _ RootMode new.
  192.     sMode _ Simple newMode.
  193.     sSMode _ Simple newMode.
  194.     rMode addSubMode: sMode in: (0.25 @ 0.25 corner: 1 @ 1).
  195.     sMode addSubMode: sSMode in: (0.25 @ 0.25 corner: 0.9 @ 0.9).
  196.     rMode startUp! !
  197.  
  198. !TestExamples class methodsFor: 'dispObj tests'!
  199.  
  200. fastDispObjTest
  201.     "(RootMode new addSubMode: self fastDispObjTest) startUp" 
  202.     "Here the 'MoveImageController1' and the 'MoveClippedImageConroller' 
  203.     is also tested.  Also m2 and m3 share the same display object. 
  204.     Shan March 29, 1989"
  205.  
  206.     | rMode m1 m2 m3 dispObj text circle  |
  207.     rMode _ ExpandedMode new.
  208.     m1 _ Simple newMode.
  209.     m1 insideColor: Form lightGray.
  210.     m2 _ Simple newMode.
  211.     m2 controller: MoveImageController1 new.
  212.     m2 insideColor: Form white.
  213.     m3 _ Simple newMode.
  214.     m3 controller: MoveClippedImageController1 new.
  215.     m3 insideColor: Form white.
  216.  
  217. "Display object stuffs."
  218.     dispObj _ m2 displayObject.
  219.     text _ 'This is a tow line
  220. text to display' asDisplayText.
  221.     text offset: 10 @ 10.
  222.     dispObj relAdd: text.
  223.     circle _ MMSCircle new.
  224.     circle form: (Form extent: 2 @ 2) black.
  225.     circle radius: 20.
  226.     circle center: 50 @ 100.
  227.     dispObj relAdd: circle.
  228.     dispObj relAdd: (MMSLine
  229.             from: 0 @ 0
  230.             to: 500 @ 50
  231.             width: 2@2 color: Form black).
  232.     dispObj makeFaster.
  233.     m3 displayObject: dispObj.
  234.  
  235.     rMode addSubMode: m3 at: 220@200.
  236.     rMode
  237.         addSubMode: m1
  238.         at: 50 @ 50
  239.         extent: 200 @ 200.
  240.     m1 addSubMode: m2 at: 30 @ 30.
  241.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  242.  
  243. lineModeTest
  244.     "TestExamples lineModeTest"
  245.  
  246.     | rMode sMode sMode2 dispObj line lMode |
  247.     rMode _ RootMode new.
  248.     sMode _ Simple newMode.
  249.     sMode2 _ Simple newMode.
  250.     sMode2 insideColor: Form darkGray.
  251.     lMode _ LineMode from: 20@20 to: 120@120 width: 2@2 color: Form black.
  252.     lMode displayObject makeFaster.
  253.     lMode controller: MoveImageController1 new.
  254.     rMode
  255.         addSubMode: sMode
  256.         at: 150 @ 50
  257.         extent: 200 @ 200.
  258.     rMode
  259.         addSubMode: lMode.
  260.     rMode
  261.         addSubMode: sMode2
  262.         at: 50 @ 150
  263.         extent: 100 @ 100.
  264.         rMode startUp!
  265.  
  266. slowDispObjTest
  267.     "(RootMode new addSubMode: self slowDispObjTest) startUp" 
  268.  
  269.     | rMode sMode sSMode dispObj text circle line lMode |
  270.     rMode _ ExpandedMode new.
  271.     sMode _ Simple newMode.
  272.     lMode _ Simple newMode.
  273.     lMode controller: MController new.
  274.     dispObj _ lMode displayObject.
  275.     line _ MMSLine
  276.                 from: 0 @ 0
  277.                 to: 500 @ 50
  278.                 width: 2 @ 2
  279.                 color: Form black.
  280.     dispObj relAdd: line.
  281.     sSMode _ Simple newMode.
  282.     dispObj _ sSMode displayObject.
  283.     text _ 'This is a tow line
  284. text to display' asDisplayText.
  285.     text offset: 10 @ 10.
  286.     dispObj relAdd: text.
  287.     circle _ MMSCircle new.
  288.     circle form: (Form extent: 2 @ 2) black.
  289.     circle radius: 20.
  290.     circle center: 50 @ 100.
  291.     dispObj relAdd: circle.
  292.     dispObj relAdd: line.
  293.     rMode
  294.         addSubMode: sMode
  295.         at: 50 @ 50
  296.         extent: 200 @ 200.
  297.     "rMode
  298.         addSubMode: lMode
  299.         at: 50 @ 50
  300.         extent: 200 @ 200."
  301.     sMode addSubMode: sSMode at: 30 @ 30.
  302.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  303.  
  304. starTest
  305.     "TestExamples starTest"
  306.  
  307.     | rMode sMode sSMode |
  308.     rMode _ RootMode new.
  309.     sMode _ Simple newMode.
  310.     sSMode _ Simple extent: 50 @ 50.
  311.     "The following two lines show the concept of independent display 
  312.     object and controller.  Shan March 28, 1989"
  313.     sSMode displayObject absAdd: MMSStar new.
  314.     sSMode controller: StarController1 new.
  315.     rMode
  316.         addSubMode: sMode
  317.         at: 30 @ 30
  318.         extent: 200 @ 200.
  319.     sMode addSubMode: sSMode at: 10 @ 10.
  320.     rMode startUp! !
  321.  
  322. !TestExamples class methodsFor: 'mode tests'!
  323.  
  324. oddShapeAndAnimationTest
  325.     "(RootMode new addSubMode: self oddShapeAndAnimationTest) startUp" 
  326.     "Test the folder which is an odd shape mode.  Shan May 7, 1989"
  327.  
  328.     | rMode sMode trash  s2Mode s3Mode s4Mode s5Mode s6Mode |
  329.     rMode _ ExpandedMode new.
  330.     sMode _ FixedImageMode new.
  331.     sMode displayObject absAdd: MMSOpaqueForm folder.
  332.     sMode controller: MoveImageController1 new.
  333. sMode highlightDispObj: #inverseHighlight.
  334.     trash _ Trash new.
  335.     "s1Mode _ FixedImageMode new.
  336.     s1Mode displayObject absAdd: MMSOpaqueForm trash.
  337.     s1Mode controller: MoveImageController1 new.
  338. s1Mode highlightDispObj: (DispObj new borderWidth: 0; absAdd: MMSOpaqueForm openTrash)."
  339.     s2Mode _ FixedImageMode new.
  340.     s2Mode displayObject absAdd: MMSOpaqueForm sheet.
  341. "s2Mode highlightDispObj: (DispObj new borderWidth: 0; absAdd: MMSOpaqueForm oddShape)."
  342.     s2Mode controller: MoveImageController1 new.
  343.     s3Mode _ FixedImageMode new.
  344.     s3Mode displayObject absAdd: MMSOpaqueForm oddShape.
  345.     s3Mode controller: MoveImageController1 new.
  346.     s4Mode _ FixedImageMode new.
  347.     s4Mode displayObject absAdd: MMSOpaqueForm folder.
  348.     s4Mode controller: MoveController1 new.
  349. s4Mode highlightDispObj: AnimationDispObj rotatingStar.
  350.     s5Mode _ FixedImageMode new.
  351.     s5Mode displayObject absAdd: MMSOpaqueForm folder.
  352.     s5Mode controller: MoveImageController1 new.
  353. s5Mode highlightDispObj: AnimationDispObj rotatingStar.
  354.     s6Mode _ FixedImageMode new.
  355.     s6Mode displayObject absAdd: MMSOpaqueForm folder.
  356.     s6Mode controller: MoveClippedImageController1 new.
  357. s6Mode highlightDispObj: AnimationDispObj rotatingStar.
  358.     rMode addSubMode: sMode.
  359.     trash attachModeTo: rMode at: 100@200.
  360.     "rMode addSubMode: s1Mode at: 100@200."
  361.     rMode addSubMode: s2Mode at: 200@200.
  362.     rMode addSubMode: s3Mode at: 200@80.
  363.     rMode addSubMode: s4Mode at: 0@80.
  364.     rMode addSubMode: s5Mode at: 0@160.
  365.     rMode addSubMode: s6Mode at: 0@240.
  366.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  367.  
  368. pollingSubModeTest
  369.     "(RootMode new addSubMode: self pollingSubModeTest) startUp"
  370.  
  371.     | rMode sMode aPollingEnvMode aStringHolderView picture |
  372.     aStringHolderView _ StringHolderView container: (StringHolder new contents: 'Text to be edited.').    "Shan March 20, 1990"
  373.     aPollingEnvMode _ PollingEnvMode extent: 250 @ 200.
  374.     aPollingEnvMode addSubView: aStringHolderView.
  375.     rMode _ ExpandedMode new.
  376.     picture _ MMSOpaqueForm shan.
  377.     rMode displayObject relAdd: (picture offset: 10 @ 10).
  378.     picture _ MMSOpaqueForm yen.
  379.     rMode displayObject relAdd: (picture offset: 70 @ 10).
  380.     picture _ MMSOpaqueForm ping.
  381.     rMode displayObject relAdd: (picture offset: 130 @ 10).
  382.     sMode _ Simple extent: 200 @ 200.
  383.     picture _ MMSOpaqueForm barry.
  384.     sMode displayObject relAdd: picture.
  385.     sMode insideColor: Form lightGray.
  386.     rMode addSubMode: aPollingEnvMode at: 150 @ 100.
  387.     rMode addSubMode: sMode at: 10 @ 90.
  388.     ^rMode resizeStyle: ResizeStyle stickFourCorners!
  389.  
  390. subModeSizeTest
  391.     "TestExamples subModeSizeTest"
  392.     "This is to test the ability of specifying the absolute size of a  
  393.     subMode. Resize the rootMode to test it. Shan March 19, 1989"
  394.  
  395.     | rMode sMode sSMode |
  396.     rMode _ RootMode new.
  397.     "The size of root mode goes with the environment StdSysView.  No 
  398.     need to specify.  Shan March 25, 1989"
  399.     sMode _ Simple origin: 50 @ 50 extent: 200 @ 200.
  400.     sSMode _ Simple origin: 20 @ 20 extent: 100 @ 100.
  401.     rMode addSubMode: sMode.
  402.     sMode addSubMode: sSMode.
  403.     rMode startUp!
  404.  
  405. vanillaTest
  406.     "TestExamples vanillaTest"
  407.  
  408.     | rMode sMode |
  409.     rMode _ RootMode new.
  410.     sMode _ Simple newMode.
  411.     rMode addSubMode: sMode.
  412.     rMode startUp! !
  413.  
  414. !TestExamples class methodsFor: 'demo'!
  415.  
  416. demoSpace
  417.     "TestExamples demoSpace"
  418.     "This is a space that accommodate all the demos of the MMS.  Shan 
  419.     June 15, 1989"
  420.  
  421.     | rMode w  |
  422.     rMode _ RootMode new.
  423.     rMode label: 'MMS Demo Space'.
  424.     rMode minimumSize: 1000 @ 830.
  425.     w _ Window title: 'Network Window' origin: 150@50 extent: 400 @ 400.
  426.     w shrinkPosition: 20@20.
  427.     w applicationMode: Net new mode.
  428.     w addVerticalScrollBar.
  429.     w addHorizontalScrollBar.
  430.     w attachModeTo: rMode.
  431.     w _ Window title: 'OddShape Window' origin: 250@350 extent: 450 @ 400.
  432.     w shrinkPosition: 20@120.
  433.     w applicationMode: Net oddShapeTest1.
  434.     w attachModeTo: rMode.
  435.     w _ Window title: 'Enter Leave' origin: 300@475 extent: 500 @ 300.
  436.     w shrinkPosition: 20@220.
  437.     w applicationMode: TestExamples enterLeaveTest.
  438.     w attachModeTo: rMode.
  439.     w _ Window title: 'Level of DM' origin: 500@25 extent: 350 @ 350.
  440.     w shrinkPosition: 20@320.
  441.     w applicationMode: TestExamples oddShapeAndAnimationTest.
  442.     w attachModeTo: rMode.
  443.     w _ Window title: 'Fast and Clipped Display' origin: 550@250 extent: 350 @ 350.
  444.     w shrinkPosition: 20@420.
  445.     w applicationMode: TestExamples fastDispObjTest.
  446.     w attachModeTo: rMode.
  447.     w _ Window title: 'For Barry' origin: 200@150 extent: 350 @ 400.
  448.     w shrinkPosition: 20@520.
  449.     w applicationMode: TestExamples pollingSubModeTest.
  450.     w attachModeTo: rMode.
  451.     w _ Window title: 'Roam demo' origin: 370@110 extent: 350 @ 400.
  452.     w shrinkPosition: 20@620.
  453.     w applicationMode: RoamBox bkScrollTest.
  454.     w attachModeTo: rMode.
  455.     w _ Window title: 'Menu demo' origin: 640@410 extent: 350 @ 400.
  456.     w shrinkPosition: 20@720.
  457.     w applicationMode: MenuTestWorkSpace menuTest.
  458.     w titleBar: ShadedTitleBar new.
  459.     w attachModeTo: rMode.
  460.     
  461.     rMode startUp!
  462.  
  463. newStart3DQuest
  464.     "ThreeDQuestEnv newStart3DQuest"
  465.     "Shan September 21, 1989"!
  466.  
  467. perfMeterTest
  468.     "Test the perfMeter.  Shan April 11, 1989"
  469.     "TestExamples perfMeterTest"
  470.  
  471.     | rMode |
  472.     rMode _ RootMode new.
  473.     rMode label: 'PerfMeter'.
  474.     rMode minimumSize: 114@109.
  475.     rMode addSubMode: PerfMeter newMode at: 2 @ 2.
  476.     rMode startUp! !
  477.  
  478. !TestExamples class methodsFor: 'composer using'!
  479.  
  480. composerUseTest
  481.     "(RootMode new addSubMode: self composerUseTest) startUp"
  482.     "Shan October 31, 1989"
  483.  
  484.     | rMode prototype |
  485.     rMode _ ExpandedMode new.
  486.     prototype _ (LibrarySpace ITStore at: 'myMode') prototype duplicate.
  487.     prototype attachModeTo: rMode at: 5 @ 5.
  488.     ^rMode resizeStyle: ResizeStyle stickFourCorners! !
  489.  
  490. Mode subclass: #FixedImageMode
  491.     instanceVariableNames: ''
  492.     classVariableNames: ''
  493.     poolDictionaries: ''
  494.     category: 'Examples-Shan'!
  495. FixedImageMode comment:
  496. 'This kind of iconic mode should be used as a superclass of a fixed size icon which is not affected by any resizing and roaming.  A good example is the close box of a title bar.  Shan May 11, 1989'!
  497.  
  498.  
  499. !FixedImageMode methodsFor: 'event-handling'!
  500.  
  501. interestedIn: event 
  502.     "The mode only responds to events that happen within the displayBox 
  503.     and within the area defined by the shape of the mask of the 
  504.     dispalyObject.  At this momet, assume there is only one 
  505.     MMSOpaqueForm in the displayObject contents.  May be changes in 
  506.     the future. Shan May 7, 1989"
  507.  
  508.     | relativePt |
  509.     visible & (self containsPoint: event origin)
  510.         ifFalse: [^false].
  511.     relativePt _ event origin - self unclippedDisplayBox origin.
  512.     (dispObj containsPoint: relativePt)
  513.         ifTrue: [^true]
  514.         ifFalse: [^false]! !
  515.  
  516. !FixedImageMode methodsFor: 'display box access'!
  517.  
  518. computeDisplayBox
  519.     "The displayBox is of the size of the image.  This disables some of the 
  520.       methods in the Mode class.  To change the size displayBox of   
  521.     OddShapeMode, one has to change the image size.  The way we   
  522.     handle the origin is still the same.  Shan May 7, 1989"
  523.  
  524.     | origin |
  525.     origin _ super computeDisplayBox origin.
  526.     self isTopView
  527.         ifTrue: [^self displayObject boundingBox moveTo: origin]
  528.         ifFalse: [^superView insetDisplayBox intersect: (self displayObject boundingBox moveTo: origin)]!
  529.  
  530. unclippedDisplayBox
  531.     "Make the unclippedDispBox the same size as the image,  Shan May 7,1989"
  532.  
  533.     ^super unclippedDisplayBox extent: dispObj boundingBox extent! !
  534.  
  535. !FixedImageMode methodsFor: 'access'!
  536.  
  537. imageForm: anOpaqueForm 
  538.     "Shan August 25, 1989"
  539.  
  540.     dispObj clear.
  541.     dispObj absAdd: anOpaqueForm.
  542.     self resizeToFitDisplayObject! !
  543.  
  544. MController subclass: #MoveClippedImageController1
  545.     instanceVariableNames: ''
  546.     classVariableNames: 'MoveClippedImageController1ERD '
  547.     poolDictionaries: ''
  548.     category: 'Examples-Shan'!
  549.  
  550. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  551.  
  552. MoveClippedImageController1 class
  553.     instanceVariableNames: ''!
  554.  
  555.  
  556. !MoveClippedImageController1 class methodsFor: 'access'!
  557.  
  558. eventResponsesDict
  559.     ^MoveClippedImageController1ERD! !
  560.  
  561. !MoveClippedImageController1 class methodsFor: 'initialize'!
  562.  
  563. ERDinit
  564.  
  565.     MoveClippedImageController1ERD _ super eventResponsesDict deepCopy.
  566.     MoveClippedImageController1ERD at: #leftButtonDown put: #moveClippedImage.
  567.     MoveClippedImageController1ERD at: #enterMode put: #highlight.
  568.     MoveClippedImageController1ERD at: #leaveMode put: #deHighlight! !
  569.  
  570. SemanticObject subclass: #Simple
  571.     instanceVariableNames: 'pen '
  572.     classVariableNames: ''
  573.     poolDictionaries: ''
  574.     category: 'Examples-Shan'!
  575.  
  576.  
  577. !Simple methodsFor: 'initialize'!
  578.  
  579. initialize
  580.     pen _ Pen new up! !
  581.  
  582. !Simple methodsFor: 'controller support'!
  583.  
  584. movePen: e
  585.     pen goto: e origin!
  586.  
  587. penDown: e
  588.     pen frame: (mode insetDisplayBox).
  589.     pen down.!
  590.  
  591. penUp: e 
  592.     pen up! !
  593. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  594.  
  595. Simple class
  596.     instanceVariableNames: ''!
  597.  
  598.  
  599. !Simple class methodsFor: 'mode creation'!
  600.  
  601. extent: ext
  602.     "Shan May 24, 1989"
  603.     | nMode|
  604.     nMode _ SimpleSubMode extent: ext.
  605.     "This will connect the semantic object, mode and controller up."
  606.     nMode semanticObject: Simple new.
  607.     ^ nMode!
  608.  
  609. newMode
  610.     "Shan May 24, 1989"
  611.     | nMode|
  612.     nMode _ SimpleSubMode new.
  613.     "This will connect the semantic object, mode and controller up."
  614.     nMode semanticObject: Simple new.
  615.     ^ nMode!
  616.  
  617. origin: org extent: ext
  618.     "Shan May 24, 1989"
  619.     | nMode|
  620.     nMode _ SimpleSubMode origin: org extent: ext.
  621.     "This will connect the semantic object, mode and controller up."
  622.     nMode semanticObject: Simple new.
  623.     ^ nMode! !
  624.  
  625. MController subclass: #MoveController1
  626.     instanceVariableNames: ''
  627.     classVariableNames: 'MoveController1ERD '
  628.     poolDictionaries: ''
  629.     category: 'Examples-Shan'!
  630.  
  631. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  632.  
  633. MoveController1 class
  634.     instanceVariableNames: ''!
  635.  
  636.  
  637. !MoveController1 class methodsFor: 'access'!
  638.  
  639. eventResponsesDict
  640.     ^MoveController1ERD! !
  641.  
  642. !MoveController1 class methodsFor: 'initialize'!
  643.  
  644. ERDinit
  645.  
  646.     MoveController1ERD _ super eventResponsesDict deepCopy.
  647.     MoveController1ERD at: #leftButtonDown put: #moveFrame.
  648.     MoveController1ERD at: #enterMode put: #highlight.
  649.     MoveController1ERD at: #leaveMode put: #deHighlight! !
  650.  
  651. MoveController1 subclass: #StarController1
  652.     instanceVariableNames: 'displayProcess '
  653.     classVariableNames: 'StarController1ERD '
  654.     poolDictionaries: ''
  655.     category: 'Examples-Shan'!
  656.  
  657.  
  658. !StarController1 methodsFor: 'Event Handling'!
  659.  
  660. enterMode
  661.     displayProcess _ [[true] whileTrue: [Processor yield. mode display]] newProcess.
  662.     displayProcess resume.
  663.     ^true!
  664.  
  665. leaveMode
  666.     displayProcess terminate.
  667.     ^true!
  668.  
  669. leftButtonDown
  670.     displayProcess suspend.
  671.     self moveFrame.
  672.     displayProcess resume.
  673.     ^true! !
  674. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  675.  
  676. StarController1 class
  677.     instanceVariableNames: ''!
  678.  
  679.  
  680. !StarController1 class methodsFor: 'initialize'!
  681.  
  682. ERDinit
  683.  
  684.     StarController1ERD _ super eventResponsesDict deepCopy.
  685.     StarController1ERD at: #leftButtonDown put: #self.
  686.     StarController1ERD at: #enterMode put: #self.
  687.     StarController1ERD at: #leaveMode put: #self! !
  688.  
  689. !StarController1 class methodsFor: 'access'!
  690.  
  691. eventResponsesDict
  692.     ^StarController1ERD! !
  693.  
  694. MoveController1 subclass: #SimpleSubController1
  695.     instanceVariableNames: ''
  696.     classVariableNames: 'SimpleSubController1ERD '
  697.     poolDictionaries: ''
  698.     category: 'Examples-Shan'!
  699.  
  700.  
  701. !SimpleSubController1 methodsFor: 'Event Handling'!
  702.  
  703. cursorMove
  704.     semObj goto: event origin.
  705.     ^true!
  706.  
  707. leaveMode
  708.     semObj penUp: event.
  709.     mode deHighlight.
  710.     ^true!
  711.  
  712. leftButtonDoubleClick
  713.     
  714.     mode flash.
  715.     ^true!
  716.  
  717. middleButtonDown
  718.     semObj frame: (mode insetDisplayBox).
  719.     semObj down.
  720.     ^true!
  721.  
  722. middleButtonUp
  723.     semObj up.
  724.     ^true! !
  725. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  726.  
  727. SimpleSubController1 class
  728.     instanceVariableNames: ''!
  729.  
  730.  
  731. !SimpleSubController1 class methodsFor: 'initialize'!
  732.  
  733. ERDinit
  734.     "SimpleSubController1 initialize"
  735.  
  736.     SimpleSubController1ERD _ super eventResponsesDict deepCopy.
  737.     SimpleSubController1ERD at: #cursorMove put: #movePen:.
  738.     SimpleSubController1ERD at: #enterMode put: #highlight.
  739.     SimpleSubController1ERD at: #leaveMode put: #self.
  740.     SimpleSubController1ERD at: #leftButtonDoubleClick put: #self.
  741.     SimpleSubController1ERD at: #middleButtonDown put: #penDown:.
  742.     SimpleSubController1ERD at: #middleButtonUp put: #penUp:.! !
  743.  
  744. !SimpleSubController1 class methodsFor: 'access'!
  745.  
  746. eventResponsesDict
  747.     ^SimpleSubController1ERD! !
  748.  
  749. SimpleSubController1 subclass: #ShowhandController1
  750.     instanceVariableNames: 'background '
  751.     classVariableNames: 'HandForm ShowhandController1ERD '
  752.     poolDictionaries: ''
  753.     category: 'Examples-Shan'!
  754.  
  755.  
  756. !ShowhandController1 methodsFor: 'private'!
  757.  
  758. eraseHand
  759.         background notNil ifTrue: [background display].!
  760.  
  761. showhand
  762.     | p |
  763.     p _ mode displayBox origin - (120 @ 24).
  764.     background _ (Form fromDisplay: (HandForm boundingBox moveTo: p))
  765.                 offset: p.
  766.     HandForm displayAt: p! !
  767.  
  768. !ShowhandController1 methodsFor: 'Event Handling'!
  769.  
  770. enterMode
  771.      mode borderColor: Form black.
  772.     mode display.
  773.     self showhand.
  774.     ^true!
  775.  
  776. leaveMode
  777.     semObj penUp: event.
  778.     mode borderColor: Form gray.
  779.     mode display.
  780.     self eraseHand.
  781.     ^true!
  782.  
  783. leftButtonDown
  784.     background notNil ifTrue: [background display].
  785.     background _ nil.
  786.     self moveFrame.
  787.     self showhand.
  788.     ^true! !
  789. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  790.  
  791. ShowhandController1 class
  792.     instanceVariableNames: ''!
  793.  
  794.  
  795. !ShowhandController1 class methodsFor: 'access'!
  796.  
  797. eventResponsesDict
  798.     ^ShowhandController1ERD! !
  799.  
  800. !ShowhandController1 class methodsFor: 'initialize'!
  801.  
  802. ERDinit
  803.  
  804.     ShowhandController1ERD _ super eventResponsesDict deepCopy.
  805.     ShowhandController1ERD  at: #leftButtonDown put: #self.
  806.     ShowhandController1ERD at: #enterMode put: #self.
  807.     ShowhandController1ERD at: #leaveMode put: #self!
  808.  
  809. initialize
  810.     "ShowhandController1 initialize"
  811.  
  812.     HandForm _ OpaqueForm figure: ((Form
  813.     extent: 120@92
  814.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7936 0 0 0 0 0 0 0 10368 0 0 0 0 0 0 0 10304 0 0 0 0 0 0 0 10336 0 0 0 0 0 0 0 18464 0 0 0 0 0 0 0 18464 0 0 0 0 0 0 0 28704 0 0 0 0 0 0 0 32800 0 0 0 0 0 0 1 32 0 0 0 0 0 0 2 32 0 0 0 0 0 0 4 64 0 0 0 0 0 0 8 64 0 0 0 0 0 0 16 128 0 0 0 0 0 0 32 128 0 0 0 0 0 0 64 256 0 0 0 0 0 0 64 17152 0 0 0 0 0 0 128 15616 0 0 0 0 0 0 256 512 0 0 0 0 0 0 256 512 0 0 0 0 0 0 512 1024 0 0 0 0 0 0 1024 2048 0 0 0 0 0 0 2048 20480 0 0 0 0 0 0 2053 12288 63 65535 32768 0 0 0 4096 8192 8160 0 32640 0 0 0 4096 8193 57344 0 126 0 0 0 8192 16446 0 4 1 0 0 0 8192 18368 0 32768 1 0 0 0 16384 14336 16385 8194 1 0 0 0 16384 12288 16385 8194 1 0 0 0 32768 15360 16385 2 1 0 0 0 32768 9984 32769 8194 1 0 0 1 0 8448 33281 8196 2 0 0 2 0 8576 512 32768 28 0 0 2 0 8385 768 64 8160 0 0 4 0 8193 256 959 57344 0 0 8 0 1 384 7168 0 0 0 16 0 3 127 57344 0 0 65280 32 0 0 128 0 0 0 30592 64 0 4 256 0 0 0 56768 128 0 4 512 0 0 0 30528 256 0 12 1016 0 0 0 56768 1536 0 0 519 0 0 0 30528 14336 0 0 1536 49152 0 0 56831 49152 0 32 1024 12288 0 0 30560 0 0 96 3072 3072 0 0 56800 0 0 192 2051 33280 0 0 30560 0 0 384 2050 256 0 0 56800 0 0 768 2168 128 0 0 30560 0 0 0 4038 128 0 0 56800 0 0 0 61442 128 0 0 30528 0 0 513 2049 128 0 0 56768 0 0 1538 1024 256 0 0 30656 0 0 3074 512 256 0 0 56768 0 0 6146 512 512 0 0 30656 0 0 4098 1024 15360 0 0 56768 0 0 1 34816 57344 0 0 30656 0 0 0 63519 4096 0 0 56768 0 0 0 28656 4096 0 0 30656 0 0 15 49152 4096 0 0 56768 0 0 24 32976 4096 0 0 30656 0 0 32 49216 4096 0 0 56768 0 0 32 16464 4096 0 0 30592 0 0 32 16576 8192 0 0 56704 0 0 16 49152 24576 0 0 30592 0 0 12 32775 32768 0 0 56704 0 0 3 65528 0 0 0 30592 0 0 0 70 0 0 0 56704 0 0 0 1922 0 0 0 30592 0 0 1 64514 0 0 0 56704 0 0 2 4290 0 0 0 30592 0 0 2 6210 0 0 0 56960 0 0 2 2148 0 0 0 30463 65024 0 2 6152 0 0 0 56832 448 0 1 32816 0 0 0 30208 60 0 0 65472 0 0 0 56320 3 33536 0 8192 0 0 0 29696 0 30080 0 8192 0 0 0 56320 0 2175 0 16384 0 0 0 31744 0 0 65535 32768 0 0 0 55296 0 0 0 0 0 0 0 28672 0 0 0 0 0 0 0 61440 0 0 0 0 0 0 0 57344 0 0 0 0 0 0 0 49152 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
  815.     offset: 0@0)) shape: ((Form
  816.     extent: 120@92
  817.     fromArray: #( 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 7936 0 0 0 0 0 0 0 8064 0 0 0 0 0 0 0 8064 0 0 0 0 0 0 0 16320 0 0 0 0 0 0 0 16320 0 0 0 0 0 0 0 16320 0 0 0 0 0 0 0 32704 0 0 0 0 0 0 0 65472 0 0 0 0 0 0 1 65472 0 0 0 0 0 0 3 65408 0 0 0 0 0 0 7 65408 0 0 0 0 0 0 15 65280 0 0 0 0 0 0 31 65280 0 0 0 0 0 0 63 65024 0 0 0 0 0 0 63 65024 0 0 0 0 0 0 127 65024 0 0 0 0 0 0 255 64512 0 0 0 0 0 0 255 64512 0 0 0 0 0 0 511 63488 0 0 0 0 0 0 1023 61440 0 0 0 0 0 0 2047 57344 0 0 0 0 0 0 2047 57344 0 0 0 0 0 0 4095 49152 31 65535 32768 0 0 0 4095 49152 8191 65535 65408 0 0 0 8191 32801 65535 65535 65534 0 0 0 8191 32831 65535 65535 65534 0 0 0 16383 51199 65535 65535 65534 0 0 0 16383 65535 65535 65535 65534 0 0 0 32767 65535 65535 65535 65534 0 0 0 32767 65535 65535 65535 65534 0 0 0 65535 65535 65535 65535 65532 0 0 1 65535 65535 65535 65535 65504 0 0 3 65535 65535 65535 65471 59392 0 0 3 65535 65535 65535 64512 0 0 0 7 65535 65535 65535 57344 0 0 0 15 65535 65535 65408 0 0 0 65280 63 65535 65535 65280 0 0 0 65408 127 65535 65535 65024 0 0 0 65472 127 65535 65535 64512 0 0 0 65472 255 65535 65535 64512 0 0 0 65472 511 65535 65535 65528 0 0 0 65472 2047 65535 65535 65535 0 0 0 65504 16383 65535 65535 65535 49152 0 0 65535 65535 65535 65535 65535 61440 0 0 65535 65535 65535 65535 65535 64512 0 0 65535 65535 65535 65535 65535 65024 0 0 65535 65535 65535 65535 65535 65280 0 0 65535 65535 65535 65535 65535 65280 0 0 65535 65535 65535 65535 65535 65280 0 0 65535 65535 65535 65535 65535 65280 0 0 65535 65535 65535 65535 65535 65024 0 0 65407 65535 65535 65535 65535 65280 0 0 65407 65535 65535 65535 65535 64512 0 0 65407 65535 65535 65535 65535 63488 0 0 65407 65535 65535 65535 65535 57344 0 0 65407 65535 65535 65535 65535 57344 0 0 65407 65535 65535 65535 65535 57344 0 0 65407 65535 65535 65535 65535 57344 0 0 65535 65535 65535 65535 65535 57344 0 0 65407 65535 65535 65535 65535 57344 0 0 65407 65535 65535 65535 65535 57344 0 0 65535 65535 65535 65535 65535 49152 0 0 65535 65535 65535 65535 65535 49152 0 0 65407 65535 65535 65535 65535 32768 0 0 65407 65535 65535 65535 65528 0 0 0 65407 65535 65535 65535 65534 0 0 0 65535 65535 65535 65535 65532 0 0 0 65535 65535 65535 65535 65532 0 0 0 65535 65535 65535 65535 65532 0 0 0 65535 65535 65535 65535 65532 0 0 0 65279 65535 65535 65535 65528 0 0 0 65152 511 65535 65535 65520 0 0 0 65024 63 65535 65535 65472 0 0 0 65024 3 65535 65535 57344 0 0 0 64512 0 31999 65535 49152 0 0 0 64512 0 2175 65535 49152 0 0 0 64512 0 1 65535 32768 0 0 0 64512 0 0 0 0 0 0 0 63488 0 0 0 0 0 0 0 61440 0 0 0 0 0 0 0 61440 0 0 0 0 0 0 0 57344 0 0 0 0 0 0 0 49152 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)
  818.     offset: 0@0)).! !
  819.  
  820. ShowhandController1 initialize!
  821.